perm filename SCMSS.OL2[NEW,LCS]1 blob sn#351070 filedate 1978-04-26 generic text, type T, neo UTF8
C******  SCMSS *********** 12/1/75
	SUBROUTINE SCMSS
	COMMON /PLTR/PLT,RHT,DIS/PTR/KWDS(1)
	COMMON/RINP/R(10,85),RPOS(2,50) /RMOD/RMODE2,SET4,IBEAM,
	1 NOSET,STEM,STUP,NTC,PS2,RAM,RDD,ITB,POSB
       COMMON R2,JA,G,H,R3,U(39)/SCM/V(78),I,LCNT,STAFF,JLIST(200),REND
C JLIST WILL SOMETIMES BE USED(WIPED OUT) FOR R(X,Y) OVERFLOW(>50 ITEMS.)
	DIMENSION RLIST(200),NOMOR(6),WARN(6),ISV(5)
C  /SCX/ ALSO IN WORDS, NEWR
	COMMON/SCX/JALPHA(30),RB,RC,JZ,IRHY,JD,KA,KB,IZ
	1/STF/RSTFAC(8),RSTJ2 /LIMIT/LIMIT,ITEM,LL,IS,IX
	1 /FRMT/F78F(1),FA1(1),FA5(1),IREAD /IDEV/IDEV
	1/XRN/RN(1) /ALF/INP(72),ML /POS/POS1,POS2,PSFB
	COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JN,DBST
	1,NFLG,IXX,ISEMI,JG,VX(50),IAMP,K,KN,M,MODE,IBLA
      EQUIVALENCE (VX1,VX(1)),(INP1,INP(1)),(VX2,VX(2)),(VX3,VX(3)),
     1(VX4,VX(4)),(VX5,VX(5)),(JLIST,RLIST)
	1 ,(INP2,INP(2)),(INP3,INP(3)),(INP4,INP(4))
	1,(ISTAR,JALPHA(8)),(ICOL,JALPHA(9)),(IRP,JALPHA(6)),
	1(ILP,JALPHA(5)),(NEG,JALPHA(2)),(IAT,JALPHA(16)),(IDOT,
	1JALPHA(3))
	DATA IXX/'X'/,LCNT/1/,ISEMI/';'/,IBLA/' '/,KSLA/'/'/
CC	ISX=IS
C  SAVE RN COUNTER FOR ZERO FEATURE AT 168
1177	IF(JA.EQ.14)GO TO 77
	IF(JA.NE.144)GO TO 11
	REREAD 80052,L,L,L,STAFF,RMODE2
C GET THE FILE NAME FOR 'READ NAME'
77	MODE=1
	POS2=0
	POS1=0
CC	THIS IS SET IN MSX NOW ****  RMODE2=R3
	CALL TYPSTR('SPACING STAFF =')
	CALL TYPFLT(SET4)
	CALL TYPCRLF
CCC	TYPE 444,SET4
	IBEAM=-1
	IZ=0
	IREAD=0
C↓↓↓↓↓↓↓↓
	GO TO 2177

11	IF(IREAD)GO TO 2304

	GO TO 111
467	IDEV=5
	GO TO 4333
CCC444	FORMAT(' TYPE POS1, POS2, (SPC)  '$)
444	SET4=RA
111	CALL SETUP
	IF(STUP.GE.0)GO TO 8
CC	IF(ST(3601).GE.0)GO TO 8
C   ST(3601) IS LOC. OF RPOS(1,1)
C SKIPS IF USING SETUP ON SOME STAFF
	IF(POS2.NE.0)GO TO 4334
C JUMP IF POS1, POS2, ETC. WERE SET UP IN FILE (* SP  ST  POS1  POS2  X)
CCC4333	TYPE 444
4333  	IF(IDEV.EQ.5)CALL TYPSTR('TYPE POS1, POS2, (SPC)  ')
	READ(IDEV,F78F,END=467)POS1,POS2,R4
CQQ	ACCEPT F78F,POS1,POS2,R4
C  DON'T USE INVIS. RESTS WITH SPACING FEATURE!!!!
	REREAD 4177,K,RA  
	IF(K.EQ.'SP')GO TO 444
C TYPE "SPn" TO SET SPACING STAFF AT THIS POINT.
	IF(POS2.EQ.0)POS2=200.
	IF(POS1.GE.POS2)GO TO 4333
C  TYPE ANY POSITIVE 3RD NUM. FOR PSUEDO-FIBONACCI SPACING OF RHYTH.
4334	STUP=STUP-R4

8	IF(JA.EQ.144)GO TO 2302
	CALL TYPCRLF
367	GO TO (1,2,3,4,5,69)MODE
2302	IF(IREAD)GO TO 2304
CCCC	REREAD 80052,L,L,L,STAFF,RMODE2
	GO TO 2177
2304	IF(IREAD.EQ.-1)REREAD 21141,L,INP
	IF(IREAD.EQ.-2)REREAD 2114,INP
CC2303	IF(INP(1).NE.ISTAR)GO TO 231
2303	RB=0
	IF(INP(1).NE.ISTAR)GO TO 2311
	REREAD 2310,L,SET4,STAFF,POS1,POS2,PSFB
C READS SPACING STAFF NUM, THIS STAFF NUM, AND POSITIONS.
C  FIRST CHAR. MUST BE * .    !!! ASSUMES NO LINE NUMBERS NOW!!!
	IF(POS2.EQ.0)POS2=200
	READ(22,2114)INP
	RB=-1
CXXXX	GO TO 2311
C TAKE OUT OLD STAFF NUM SETUP ONE OF THESE DAYS.
2311	CALL TYPSTR('STAFF NUM=')
CCC2311	TYPE 80053
	IF(RB)GO TO 231
	IF(STFNUM(STAFF))GO TO 2305
CCC231	TYPE 80052,STAFF
231	CALL TYPFLT(STAFF)
CCC	IF(RB)TYPE 444,SET4
	IF(RB.GE.0)GO TO 4177
	CALL TYPCRLF
	CALL TYPSTR('SPACING STAFF =')
	CALL TYPFLT(SET4)
	CALL TYPCRLF
C FILE CAN SET STAFF # AND SPACING STAFF # (STn/SPn/)
CC	IF(JA.EQ.144)GO TO 2177
	GO TO 4177
167	IDEV=5
	GO TO 2311
CQQ2305	ACCEPT 80052,STAFF
2305	READ(IDEV,80052,END=167)STAFF
  	IF(STAFF.NE.444)GO TO 2177
	REREAD 4177,RA,RB
	IF(RA.NE.'SP')GO TO 4177
C NOW SPACER CAN BE SET AT THIS POINT
	SET4=RB
	GO TO 2303
4177	FORMAT(A2,F)
2310	FORMAT(A1,5F)
CO	TYPE 8009,MODE,INP
2177	IF(IREAD)CALL TYPOUT
	IF(STAFF.GE.99)GO TO 690
C  TYPE 99 OR 999 TO ESCAPE WHEN IN READ-IN MODE
	REND=0
	IF(IREAD)GO TO 80041
	IF(LOOK(L)+LOOKD(L))GO TO 101 
	CALL TYPSTR('FILE NOT FOUND - ')
	CALL TYPWRD(L)
	CALL TYPCRLF
CCC	TYPE 101,L
	GO TO 690
CC101	FORMAT(' FILE NOT FOUND - ',A5)
101	IREAD=-1
C FOR 1ST TIME IN BEAMS.
	REWIND 22
	CALL IFILE(22,L)
2301	IF(IREAD.EQ.-2)GO TO 2307
	READ(22,21141,END=68),L,INP
	IF(L.NE.0)GO TO 2300
C  JUMP IF LINE NUMBERS
	IF(INP1.EQ.'O')GO TO 2307
	IREAD=-2
C  THIS IS FOR NON-'ET' FILES WITH NO LINE NUMBS.
	REREAD 2114,INP
	GO TO 2300
2307	READ(22,2114,END=68)INP
	IF(IREAD.EQ.-2)GO TO 2300
	IF(INP3.NE.ISEMI)GO TO 2307
	IREAD=-2
	READ(22,2114)INP
	GO TO 2307
2300	IF(JA.NE.144)GO TO 2308
	IF(MODE.EQ.1)GO TO 2303
2308	IF(MODE.EQ.6)GO TO 1111
	IF(INP1.EQ.IBLA)GO TO 8006
	IF(INP1.EQ.ISEMI)GO TO 8006
C  'ET' FILES MUST HAVE ';' AS 1ST CHAR.  BLANK LINES ARE IGNORED!!
CO	TYPE 8009,MODE,INP
	CALL TYPOUT
	GO TO 6177
1111	MODE=1
	REND=2
	IZ=0
	RETURN
C   ABOVE ALLOWS MORE STAVES TO BE READ
CC168	IF(NOSET.EQ.0)RETURN

C NEXT NO LONGER NEEDED (I HOPE!)
CC	L=ISX
CC2168	RA=RN(L+1)
CC	IF(RA.EQ.1)GO TO 3168
CC	IF(RA.NE.2)GO TO 1168
CC	N=7
CC	GO TO 4168
CC3168	IF(RN(L).LT.7)GO TO 1168
C  SKIP NOTES SANS RHYTH. (CHORD NOTES.)
CC	N=9
CC4168	RN(L+N)=0
C  ZEROS RHYTHM OF ADDED INPUT ON SPACING STAFF
CC1168	L=L+RN(L)+3
CC	IF(L.LT.IS)GO TO 2168
CC	RETURN

CCC80053	FORMAT(' STAFF NUM='$)
80052	FORMAT(F,A4,A5,2F)
CCC444	FORMAT(' SPACING STAFF =',F3.0)
267	IDEV=5
	GO TO 367
4	IF(IDEV.EQ.5)CALL TYPSTR('ADD BEAMS?  ')
CCC4	TYPE 8002
CC330	ACCEPT 2114,N,L,INP3,INP4
330	READ(IDEV,2114,END=267)INP
CQQ330	ACCEPT 2114,INP
	IF(INP1.EQ.'G')GO TO 69
C  TYPE 'GO' TO PASS LATER ITEMS
	IF(INP1.EQ.'9'.AND.INP2.EQ.INP1)GO TO 99
	IF(INP1.EQ.'B')GO TO 99
	IF(INP1.EQ.'Y')GO TO 1
CQQ	DO 2001 K=2,6
CQQ2001	IF(INP(K).EQ.'B')GO TO 134
C  FOR BEAMS? TYPE 'nB' INSTEAD OF 'Y' FOR AUTOMATIC.
	IF(INP1.EQ.'N')GO TO 2000
	IF(INP1.EQ.ISEMI)GO TO 2000
   	IF(INP1.NE.IBLA)GO TO 5177
CQQ	IF(INP1.NE.IBLA)GO TO 11
C  PICKS UP TYPOS
2000	MODE=MODE+1
	IF(IDEV.EQ.5)WRITE(21,2114)INP4
	GO TO 11
CCC691	FORMAT(' INPUT SAVED ON FOR21.DAT')
69	IF(IDEV.EQ.1)GO TO 690
	END FILE 21
	CALL TYPSTR('INPUT SAVED ON FOR21.DAT')
	CALL TYPCRLF
CCC	TYPE 691
690	REND=1
	RETURN
CC	GO TO 168
3	IF(IDEV.EQ.5)CALL TYPSTR('ADD MARKS?  ')
CCC3	TYPE 8023
	GO TO 330
5	IF(IDEV.EQ.5)CALL TYPSTR('ADD SLURS?  ')
CCC5	TYPE 8022
	GO TO 330

8006	MODE=MODE+1
	IF(MODE.NE.2)GO TO 177
	IF(RMODE2.EQ.2)GO TO 80041
C   FOR NEW INPUT FORMAT -- TYPE 14 2 OR 144 -2 ETC.
177	IF(IREAD)GO TO 2301
	IF(MODE.GT.5)GO TO 677
	IF(IDEV.EQ.1)GO TO 367 
C RETURN ONLY IF IN TTY MODE. (NOT READING A FILE)
	RETURN
677	IF(IDEV.EQ.1)GO TO 68
	END FILE 21
	CALL TYPSTR('INPUT SAVED ON FOR21.DAT')
	CALL TYPCRLF
CCC	TYPE 691
68	REND=-1
	RETURN
CC	GO TO 168

99	IF(INP3.EQ.'9')GO TO 999
C ELSE GET ANOTHER CHANCE TO SAY 'NO'.  99=BACKUP,  999=ESCAPE
	MODE=MODE-1
	IF(MODE.EQ.0)GO TO 999
	IS=ISV(MODE)
	GO TO 11
C  INSERT BACKUP ROUTINE
999	REND=99
	RETURN
C FIX BACKUPS********

CCC8008	FORMAT(' TYPE ',I2,' RHYTHMS')
CCC8002	FORMAT(' ADD BEAMS?  '$)
CCC8022	FORMAT(' ADD SLURS?  '$)
CCC8023	FORMAT(' ADD MARKS?  '$)
CO8009	FORMAT(I2,4X,72A1)
CCC8011	FORMAT(' TOTAL RHY=',F7.3,' QTRS.',
CCC	1 I5,' MORE RHYTHMS NEEDED'/)
8015	RA=0
	DO 15 J=1,I-1
15	RA=RA+V(J)
	RA=RA/4.
	K=IRHY-I+1
	CALL TYPSTR('TOTAL RHY=')
	CALL TYPFLT(RA)
	CALL TYPSTR(' QTRS. ')
	CALL TYPINT(K)
	CALL TYPSTR(' MORE RHYTHMS NEEDED')
	CALL TYPCRLF
	IDEV=5
C RETURNS TO TTY MODE IF READING A FILE WITH 'FILE' FEATURE.
CCC	TYPE 8011,RA,K
	IF(IREAD)IREAD=-IREAD
C  ↑↑↑↑↑ SO YOU CAN TYPE MORE LINES WHEN ERROR ON READIN.
2	IF(IDEV.EQ.5)CALL TYPSTR('TYPE ')
	CALL TYPINT(IRHY)
	CALL TYPSTR(' RHYTHMS')
	CALL TYPCRLF
CCC2	TYPE 8008,IRHY

1	ISV(MODE)=IS
	CALL TYPE
	REREAD 4177,RA,RB
	IF(RA.NE.'SP')GO TO 5177
	SET4=RB
C CAN SET SPACER HERE
	GO TO 1177
5177	IF(INP1.EQ.IBLA) GO TO 1
	IF(INP1.NE.'9')GO TO 80041
	IF(INP2.EQ.'9')GO TO 99
C  TYPE '99' TO BACK-UP
80041	IF(IREAD.LT.0)GO TO 6177
	IF(IDEV.EQ.5)WRITE(21,2114)INP
6177	CALL LNEND
	IF(MODE.GE.3)GO TO 133
	RETRO=-1.
	I=1
	PARENS=0
	MOT=0
      JZ=1  
	IAMP=0
C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
      KL=0  
      RA=0  
	IF(MODE.EQ.2)GO TO 2408
C NEXT CHECKS FOR STAFF NUM AT FRONT OF INPUT LINE#1.
	IF(INP(1).NE.'S')GO TO 2408
	IF(INP(2).NE.'T')GO TO 2408
	K=1
	L=3
	IF(INP3.NE.'-')GO TO 1277
	K=-1
	L=4
1277	STAFF=NALF(INP(L))*K
2277	MLX=L+1
	IF(INP(MLX).NE.KSLA)GO TO 2277
	MLX=MLX+1
	GO TO 3277
2408	MLX=1
3277	L=-1
	IF(RMODE2.EQ.2)CALL PRESCN
C   GO SORT OUT THE NEW FORMAT
	DO 2999 K=1,72
	N=INP(K)
	IF(N.EQ.IBLA)GO TO 2999
	L=0 
	IF(N.EQ.ISTAR)GO TO 277
	IF(N.NE.ISEMI)GO TO 2999
C  READS 72 CHARS. INCLUDING ;.
277	INP(K+1)=ISEMI
	GO TO 1773
C  --- X/Y/Z* ---  WITH NO SEMICOLON WORKS FOR THIS PROG. ONLY!
2999	CONTINUE
	IF(IREAD)GO TO 8015
	CALL TYPSTR('****** TRY AGAIN ***** ')
	CALL TYPCRLF
CCC	TYPE 6999
	GO TO 1
CCC6999	FORMAT(' ****** TRY AGAIN ***** ')
CC	GO TO 69
C   ERROR IF NO '*' OR ';' AT END OF LINE.

1299	IF(JZ.NE.0)GO TO 1773
7773	IF(MODE.NE.2)GO TO 377
	IF(RMODE2.EQ.2)GO TO 77732
C  ↑↑↑↑↑↑ FOR NEW INPUT FORMAT
377	IF(IREAD.EQ.0)GO TO 77731
C   BYPASS IF NOT USING EDIT FILE
	IF(IREAD.EQ.-1)READ(22,21141),L,INP
	IF(IREAD.EQ.-2)READ(22,2114)INP
C   TO READ 2ND LINE OF NOTE INPUT, IF NEEDED
CO	TYPE 8009,MODE,INP
	CALL TYPOUT
	GO TO 77732
77731	CALL TYPE

	IF(INP1.EQ.IBLA)GO TO 7773
	IF(IDEV.EQ.5)WRITE(21,2114)INP
77732	CALL LNEND
	JM=-1
	JZ=0
	GO TO 2408
C   'LISTS' MUST END WITH ; 
1773	JZ=0
	DBST=1.
	IF(XDBST)DBST=-DBST
	XDBST=0
17731	ML=MLX
	IF(PARENS.LE.0.)GO TO 975
C  PARENS=-1, OPENS; =1, CLOSES; =0, NONE
3362	PARENS=0
	MOT=I-LMOT
	IF(LCNT+MOT.LT.198)GO TO 33621
CCC	DATA NOMOR/30H(' NO ROOM FOR MOTIVE ',A1/)   / 
	CALL TYPSTR(' NO ROOM FOR MOTIVE ')
	CALL TYPCHR(JMOT,1)
	CALL TYPCRLF
CCC	TYPE NOMOR,JMOT
	GO TO 1
33621	JLIST(LCNT+1)=MOT
	LCNT=LCNT+2
	DO 2140 JG=0,MOT-1
2140	RLIST(LCNT+JG)=V(LMOT+JG)
	LCNT=LCNT+MOT
	IF(IAMP)GO TO 3013
C  FOR CLOSE PARENS ON LAST ITEM
C   STORE MOTIVE IN RLIST ARRAY

975	DO 236 JDD=ML,72
	JD=JDD
	N=INP(JD)
C ((((())))) MAY 13,71 /Z (D4/E/X 2 3/) CS/ ETC.  CAN USE 26 LABELS.
	IF(N.EQ.ILP)GO TO 477
	IF(N.EQ.IRP)GO TO 477
	IF(N.NE.ICOL)GO TO 2361
477	INP(JD)=IBLA
	IF(N.NE.ICOL)GO TO 1113
	XDBST=-1.
	GO TO 5362
C  GO CHANGE IT TO A SEMIC.  !!! CAN'T END LINE WITH :
C SO NXT NOTE WILL BE DBST (TYPE /F:A:C/ ETC.)
C  DBSTS WILL BE ONLY ONE 'REP' UNIT X*0Z%~#&@
1113	L=JD-1
5113	IF(INP(L).NE.IBLA)GO TO 2113
	L=L-1
	GO TO 5113
2113	IF(N.EQ.IRP)GO TO 3361
C  ONLY ONE () AS YET,  NO NESTING
1140	JMOT=INP(L)
C   MOTIVE NAME
	DO 11401 JC=1,LCNT-1
	IF(JMOT.NE.JLIST(JC))GO TO 11401
C  FINDS DUPLICATE IDENTIFIER
CCC11402	FORMAT(' MOTIVIC (',A1,') USED TWICE')
	CALL TYPSTR(' MOTIVIC (')
	CALL TYPCHR(JMOT,1)
	CALL TYPSTR(') USED TWICE')
	CALL TYPCRLF
CCC	TYPE 11402,JMOT
	JLIST(JC)=0
C  ZERO OUT PREVIOUS USE OF IDENTIFIER.
11401	CONTINUE
	JLIST(LCNT)=JMOT
	PARENS=-1.
C   A PARENTH IS OPEN
	INP(L)=IBLA
	LMOT=I
C   LMOT IS CURRENT POINT IN V ARRAY
	GO TO 236
3361	IF(PARENS.NE.0)GO TO 33612
CCC	DATA WARN/30H(' PARENTH ERROR - GOING ON'/)/
	CALL TYPSTR('PARENTH ERROR - GOING ON')
	CALL TYPCRLF
CCC	TYPE WARN
33611	INP(JD)=IBLA
	GO TO 236
33612	PARENS=1.
C   SETS PARENS CLOSED FLAG
	GO TO 33611
C   NO INVERSIONS POSSIBLE NOW
2361	IF(N.NE.IAT)GO TO 5361
	DO 113 L=1,72
	K=JD+L
C   K IS USED AT 240!!!
	JG=INP(K)
	IF(JG.NE.NEG)GO TO 7113
	RETRO=0
	INP(K)=IBLA
	GO TO 113
7113	IF(JG.NE.IBLA)GO TO 4113
113	CONTINUE
4113	DO 6361 L=1,LCNT
	IF(JG.NE.JLIST(L))GO TO 6361
	VX1=0
	DO 40 M=JD+2,72
	JG=INP(M)
	IF(JG.EQ.IBLA)GO TO 40
	IF(JG.EQ.KSLA)GO TO 140
	IF(JG.EQ.ISEMI)GO TO 140
	IF(JG.EQ.ISTAR)GO TO 140
	ML=M
	GO TO 240
40	CONTINUE
240	JC=JM
	JM=-1
	INP(K)=IBLA
	JN=0
C   MUST BE ZERO IN SCANR
	CALL SCANR
	JM=JC
140	JC=1
	KN=L+2
	M=KN+JLIST(L+1)
	IF(RETRO)GO TO 940
	KN=M-1
	M=L+1
	JC=-1
	RETRO=-1.

940	Z=RLIST(KN)
	IF(VX1.EQ.0)GO TO 540
C  " @Q N "  WHERE N= DIATONIC STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
	IF(MODE.EQ.1)GO TO 440
C  MODE 1 IS NOTES, 2 IS RHY.
	V(I)=Z*VX1
	GO TO 7361
440	IF(ABS(Z).GE.2000.)GO TO 540
C  SKIPS NON-NOTES
	RB=VX1
	IF(Z)RB=-RB
C NOW TRANSPOSES BY DIAT. STEPS ONLY 100S=FLAT, 200S=SHARP, 300S=NAT
C  NEG NUMS ARE CHORD NOTES.
	V(I)=Z+RB
	GO TO 7361
540	V(I)=Z
7361	I=I+1
	KN=KN+JC
	IF(KN.NE.M)GO TO 940

	RB=V(I-1)
	DO 8361 L=JD,72
	JG=INP(L)
	INP(L)=IBLA
	IF(JG.EQ.KSLA)GO TO 9361
	IF(JG.EQ.ISEMI)GO TO 93611
8361	IF(JG.EQ.ISTAR)IAMP=-1
9361	MLX=L
	IF(IAMP.EQ.0)GO TO 17731
	JZ=-1
93611	IF(IAMP)GO TO 3013
	GO TO 7773
6361	CONTINUE
CCC	TYPE 6362,JG
	CALL TYPSTR(' MOTIVIC (')
	CALL TYPCHR(JG,1)
	CALL TYPSTR(') NOT FOUND')
	CALL TYPCRLF
	GO TO 11401
CCC	GO TO 11402
CCC6362	FORMAT(' MOTIVIC (',A1,') NOT FOUND')
C @@@@@@@@@@@@@@@@@@@@@@@@@@
5361	IF(N.NE.KSLA)GO TO 636
5362	MLX=JD+1
	JZ=-1
	INP(JD)=ISEMI
436	IF(INP(MLX).NE.IBLA)GO TO 103
	MLX=MLX+1
	GO TO 436
636	IF(N.EQ.ISEMI)GO TO 103
936	IF(N.NE.IDOT)GO TO 736
	L=INP(JD+1)
	KL=NALF(L)
	IF(L.LE.0)GO TO 577
	IF(KL.LT.0)GO TO 577
	IF(KL.LE.9)GO TO 236
C   JUMP IF IT'S A NUMBER
577	IF(MODE.EQ.2)INP(JD)=1
C :::::::::******* ↑↑↑↑ MODE #?
	GO TO 236
C   CHANGES DOTTED RHYTHMS TO '1'S.
736	IF(N.NE.ISTAR)GO TO 236
	IAMP=-1
	INP(JD)=ISEMI
	GO TO 103
236	CONTINUE
2114	FORMAT(72A1)
21141	FORMAT(I,72A1)

5016	IF(IAMP.GE.0)GO TO 1299
	IF(PARENS.NE.0)GO TO 3362
C  PARENS ARE STILL OPEN?
	GO TO 3013
103	K=INP(ML)

C   LAST SECTION
	IF(K.EQ.ISEMI)GO TO 1014
C*********** MODE #?
	IF(K.NE.IBLA) GO TO 1899
	ML=ML+1
	GO TO 103
1899	JN=0
C   MUST BE ZERO IN SCANR
	VX4=0
	NOAC=0
	CALL SCANR
      IF(VX1.EQ.-99.)GO TO 4022
C NO MORE COMPOSITES IN RHYTH.  DOTS ARE INDICATED BY 100S.
C RHYTH. NUMB IS KEPT HERE.  DOTTED QUARTER IS NOW 104. DBL..=204
17	V(I)=VX1
	IF(VX4.EQ.0)GO TO 115
	IF(MODE.NE.1)GO TO 115
	I=I+1
C  FOR + OR -.  AUTO OCTAVES, ETC.
	V(I)=-VX1-VX4
115	IF(JJ.LE.1)GO TO 114
	IF(MODE.NE.1)GO TO 171
	IF(VX2.EQ.0)GO TO 171
C  JUMP IF RHY OR 'X 4' ETC.
	V(I)=18000.0+VX1*10.0+VX2/10.0
C  PACKS 2 METER NUMS INTO ONE SLOT (18xyz.n  xy=top, zn=bottom)
114	I=I+1
	GO TO 5016
171	JC=1
	JD=VX(JJ)-1
	I=I+1
	GO TO 5005
1014	JD=1
	JC=1
C  X4/ CREATES REP 1,4;  A/// CREATES REP 1,3;
	GO TO 5005
4022      JC=VX2+.3
      JD=VX3-.5
	IF(JJ.EQ.2)JD=1
C   JD=HOW MANY TIMES,  JC=HOW MANY NOTES 
5005	N=0
	DO 3005 K=I-1,1,-1
	IF(V(K))GO TO 3005
	IF(V(K).LT.3000)N=N+1
C  COUNTS RESTS AND NOTES ONLY (NO CHORD NOTES)
3005	IF(N.EQ.JC)GO TO 4005
4005	IF(JC.GT.1)GO TO 7005
	IF(MODE.EQ.1)NOAC=-1
C 5/76 *******   AF/// WILL CREATE AF/A//-- AN:FS/// = AN:FS/A:F// *******
C  ACCIS ARE DROPPED WITH / OR Xn REPEAT.  (BUT NOT WITH 'REP' OR '/X n,n/')
7005	JC=I-K
C  ALL THIS IS TO FIND COMPLETE CHORDS, BARS, ETC. TO REPEAT.
C  REPS WILL ONLY COUNT RHYTHMIC UNITS.!
	DO 1005 K=1,JD    
       NL=I+JC-1  
      DO 2005 L=I,NL    
	KN=L-JC
	RB=V(KN)
	IF(NOAC.GE.0)GO TO 2005
	IF(ABS(RB).GE.2000)GO TO 2005
C  SKIP OVER IF NOT A NOTE
	RB=AMOD(RB,100.0)+1000.0
	IF(V(KN))RB=RB-2000.0
C  DROPS ACCIS WHEN SLASH REP. OR 'X' IS USED.
2005	V(L)=RB
1005      I=I+JC  
      GO TO 5016  

3013	IF(MODE.NE.2)GO TO 771
	IF(I-1.NE.IRHY)GO TO 8015
C  WRONG NUMBER OF ITEMS
771	V(I)=-99.
	IF(MODE.NE.1)GO TO 132
C  FOR ADDED NOTES ON SPACING STAFF
	CALL NOTES
C SAVES TOTAL OF ITEMS FOR LABEL 168
67	CALL NEWR
	GO TO 8006
132	IF(IREAD.GT.0)IREAD=-IREAD
	CALL RHYTH
C  =50 IS RHYTHM FOR TEXT
	GO TO 67
134	IF(IDEV.EQ.5)WRITE(21,2114)INP
C  WRITES TYPED IN REPLY TO 'ADD BEAMS?'
C   ACCENTS ARE IN BEAMS SUBROUTINE
133	CALL BEAMS
	IF(MODE.EQ.3)GO TO 135
	IF(MODE.EQ.4)IBEAM=0
C  ADJUSTS STEMS (IBEAM=0) IF BEAMS WERE ENTERED.
	GO TO 8006
135	K=IS
	CALL NEWR
	IS=K
C  ↑↑↑↑↑↑ TO ADD NEW ITEMS, SUCH AS PPP, MP, CRESC., ETC.(SEE 'MARKS')
	GO TO 8006
	END